home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_d / tpop3.zip / MSGDCD.PAS < prev    next >
Pascal/Delphi Source File  |  1996-03-29  |  9KB  |  366 lines

  1. unit Msgdcd;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls,
  6.   Buttons, ExtCtrls, Dialogs, SysUtils, MsgUtils,
  7.   Mime;
  8.  
  9. type
  10.   EDecodeError = class(Exception);
  11.   TEncMethod = (emNone,emBase64,emQtPrn);
  12.  
  13.   TSection = class
  14.     EncMethod : TEncMethod;
  15.     FileName : string;
  16.     MIMEType : string;
  17.     Data : TMemoryStream;
  18.     constructor Create;
  19.     destructor Destroy;
  20.   end;
  21.  
  22.   TMsgProcessor = class(TForm)
  23.     Panel1: TPanel;
  24.     Memo1: TMemo;
  25.     SaveButton: TBitBtn;
  26.     DecodeButton: TBitBtn;
  27.     CloseButton: TBitBtn;
  28.     SaveDialog1: TSaveDialog;
  29.     procedure DecodeButtonClick(Sender: TObject);
  30.     procedure SaveButtonClick(Sender: TObject);
  31.   private
  32.     { Private declarations }
  33.     MsgStream : TMemoryStream;
  34.     Sections : TList;
  35.     MsgLines : TStrings;
  36.     Headers : TStrings;
  37.     procedure FillHeaders;
  38.     procedure ProcessSectionLines(Lines : TStrings);
  39.     procedure HandleSingleSection;
  40.     procedure HandleMultipleSections;
  41.     procedure ProcessSections;
  42.     procedure Process;
  43.     function GetFirstPart(const s : string) : string;
  44.     function GetEncMethod(Hdr : TStrings) : TEncMethod;
  45.   public
  46.     { Public declarations }
  47.     constructor Create(AOwner : TComponent; AStream : TMemoryStream);
  48.     destructor Destroy; override;
  49.   end;
  50.  
  51. var
  52.   MsgProcessor: TMsgProcessor;
  53.   AttachmentsDir : string;
  54.  
  55. implementation
  56.  
  57. {$R *.DFM}
  58.  
  59. {TSection}
  60. constructor TSection.Create;
  61. begin
  62.   inherited Create;
  63.   Data:=TMemoryStream.Create;
  64. end;
  65.  
  66. destructor TSection.Destroy;
  67. begin
  68.   Data.Free;
  69.   inherited Destroy;
  70. end;
  71.  
  72. constructor TMsgProcessor.Create(AOwner : TComponent; AStream : TMemoryStream);
  73. var
  74.   OutFileName : string;
  75. begin
  76.   inherited Create(AOwner);
  77.   MsgStream:=AStream;
  78.   MsgLines:=TStringList.Create;
  79.   MsgStream.Position:=0;
  80.   try
  81.     MsgLines.LoadFromStream(MsgStream);
  82.   except
  83.     on EListError do
  84.     begin
  85.       if MessageDlg('Unable to process this message because it is too large'^M^J+
  86.         'Do you want to save it as file?',mtError,[mbYes,mbCancel],0)=mrYes then
  87.       begin
  88.         AttachmentsDir:=AddBackSlash(AttachmentsDir);
  89.         OutFileName:=AttachmentsDir+'message.txt';
  90.         if InputQuery('Saving a Message','Enter the name of output file:',
  91.                       OutFileName) then
  92.          MsgStream.SaveToFile(OutFileName);
  93.       end;
  94.       DecodeButton.Enabled:=false;
  95.     end;
  96.   end;
  97.   try
  98.     Memo1.Lines:=MsgLines;
  99.   except
  100.     MessageDlg('Text is too large.  Only part will be displayed',
  101.                mtError,[mbOk],0);
  102.   end;
  103.   MsgStream.Position:=0;
  104.   Headers:=TStringList.Create;
  105.   Sections:=TList.Create;
  106. end;
  107.  
  108. destructor TMsgProcessor.Destroy;
  109. var
  110.   i : Integer;
  111. begin
  112.   for i:=Sections.Count-1 DownTo 0 do
  113.     TSection(Sections[i]).Free;
  114.   Sections.Free;
  115.   Headers.Free;
  116.   MsgLines.Free;
  117.   inherited Destroy;
  118. end;
  119.  
  120. procedure TMsgProcessor.FillHeaders;
  121. var
  122.   s : string;
  123. begin
  124.   Headers.Clear;
  125.   while (MsgLines.Count<>0) and (MsgLines[0]<>'') do
  126.   begin
  127.     s:=MsgLines[0];
  128.     Headers.Add(s);
  129.     MsgLines.Delete(0);
  130.   end;
  131. end;
  132.  
  133. function TMsgProcessor.GetFirstPart(const s : string) : string;
  134. {Gets first part of the Header line, where descr is truncated}
  135. var
  136.   sLen : byte absolute s;
  137.   i : byte;
  138. begin
  139.   Result:='';
  140.   i:=1;
  141.   while (i<=sLen) and not (s[i] in [' ',';']) do
  142.   begin
  143.     Result:=Concat(Result,s[i]);
  144.     Inc(i);
  145.   end;
  146.   Result:=TrimStr(Result);
  147. end;
  148.  
  149. function TMsgProcessor.GetEncMethod(Hdr : TStrings) : TEncMethod;
  150. var
  151.   s : string;
  152. begin
  153.   s:=UpperCase(GetHeaderValue(Hdr,'Content-Transfer-Encoding'));
  154.   if s='BASE64' then
  155.     Result:=emBase64
  156.   else
  157.   if s='QUOTED-PRINTABLE' then
  158.     Result:=emQtPrn
  159.   else
  160.     Result:=emNone;
  161. end;
  162.  
  163. procedure TMsgProcessor.ProcessSectionLines(Lines : TStrings);
  164. var
  165.   LocalHeaders : TStrings;
  166.   TempSection : TSection;
  167.   s : string;
  168. begin
  169.   LocalHeaders:=TStringList.Create;
  170.   try
  171.     while (Lines.Count<>0) and (Lines[0]<>'') do
  172.     begin
  173.       s:=Lines[0];
  174.       LocalHeaders.Add(s);
  175.       Lines.Delete(0);
  176.     end;
  177.     TempSection:=TSection.Create;
  178.     s:=GetHeaderValue(LocalHeaders,'Content-Type');
  179.     if s=InvStr then
  180.     begin
  181.       TempSection.Free;
  182.       raise EDecodeError.Create('Missing required field - Content-Type');
  183.     end;
  184.     TempSection.MimeType:=GetFirstPart(s);
  185.     if Pos('PARTIAL',UpperCase(TempSection.MimeType))>0 then
  186.       raise EDecodeError.Create('Unable to handle multipart messages');
  187.     s:=GetParameter('name',s);
  188.     if s<>InvStr then
  189.       TempSection.FileName:=s;
  190.     s:=GetHeaderValue(LocalHeaders,'Content-Disposition');
  191.     s:=GetParameter('filename',s);
  192.     if s<>InvStr then
  193.       TempSection.FileName:=s;
  194.     TempSection.EncMethod:=GetEncMethod(LocalHeaders);
  195.     Lines.SaveToStream(TempSection.Data);
  196.     TempSection.Data.Position:=0;
  197.     Sections.Add(TempSection);
  198.   finally
  199.     LocalHeaders.Free;
  200.   end;
  201. end;
  202.  
  203. procedure TMsgProcessor.HandleSingleSection;
  204. var
  205.   TempLines : TStrings;
  206. begin
  207.   TempLines:=TStringList.Create;
  208.   TempLines.AddStrings(Headers);
  209.   try
  210.     TempLines.AddStrings(MsgLines);
  211.     ProcessSectionLines(TempLines);
  212.   finally
  213.     TempLines.free;
  214.   end;
  215. end;
  216.  
  217. procedure TMsgProcessor.HandleMultipleSections;
  218. var
  219.   TempLines : TStrings;
  220.   Boundary : string;
  221.   s : string;
  222.   i : Integer;
  223.   Finished : boolean;
  224.   BLen : byte;
  225. begin
  226.   s:=GetHeaderValue(Headers,'Content-Type');
  227.   Boundary:='';
  228.   if Pos('MULTIPART',UpperCase(s))<>0 then
  229.     Boundary:=GetParameter('Boundary',s);
  230.   if Boundary=InvStr then
  231.     raise EDecodeError.Create('Miltipart message does not contain'^M^J+
  232.                               '   the ''boundary'' parameter.');
  233.   if Boundary<>'' then
  234.   begin
  235.     if Boundary<>'' then Boundary:=Concat('--',Boundary);
  236.     BLen:=Length(Boundary);
  237.     try
  238.       TempLines:=TStringList.Create;
  239.       i:=0;
  240.       while (i<MsgLines.Count) and (Copy(MsgLines[i],1,BLen)<>Boundary) do
  241.         Inc(i);
  242.       if i=MsgLines.Count then
  243.         raise EDecodeError.Create('Invalid format.');
  244.     repeat
  245.       Inc(i);
  246.       TempLines.Clear;
  247.       while (i<MsgLines.Count) and (Copy(MsgLines[i],1,BLen)<>Boundary) do
  248.       begin
  249.         TempLines.Add(MsgLines[i]);
  250.         Inc(i);
  251.       end;
  252.       Finished:=(i=MsgLines.Count) or (MsgLines[i]=Concat(Boundary,'--'));
  253.       ProcessSectionLines(TempLines);
  254.     until Finished;
  255.     finally
  256.       TempLines.Free;
  257.     end;
  258.   end
  259.   else
  260.     HandleSingleSection;
  261. end;
  262.  
  263. procedure TMsgProcessor.ProcessSections;
  264. var
  265.   i : Integer;
  266.   TempLines : TStringList;
  267.   TempStream : TMemoryStream;
  268.   Section : TSection;
  269. begin
  270.   MsgLines.Clear;
  271.   TempLines:=TStringList.Create;
  272.   TempStream:=TMemoryStream.Create;
  273.   try
  274.     for i:=0 to Sections.Count-1 do
  275.     begin
  276.       Section:=TSection(Sections[i]);
  277.       case Section.EncMethod of
  278.         emNone :
  279.         begin
  280.           TempLines.LoadFromStream(Section.Data);
  281.           MsgLines.AddStrings(TempLines);
  282.         end;
  283.         emBase64:
  284.         begin
  285.           TempLines.LoadFromStream(Section.Data);
  286.           TrimStringList(TempLines);
  287.           TempStream.Clear;
  288.           with TBase64.Create(TempStream,TempLines) do
  289.           try
  290.             Decode;
  291.           finally
  292.             free;
  293.           end;
  294.           TempStream.SaveToFile(AttachmentsDir+Section.FileName);
  295.           MsgLines.Add('--Section '+IntToStr(i)+'--');
  296.           MsgLines.Add('Decoded and saved as '+AttachmentsDir+Section.FileName);
  297.           MsgLines.Add('----');
  298.         end;
  299.         emQtPrn :
  300.         begin
  301.           TempLines.LoadFromStream(Section.Data);
  302.           TrimStringList(TempLines);
  303.           TempStream.Clear;
  304.           with TQuotedPrintable.Create(TempStream,TempLines) do
  305.           try
  306.             Decode;
  307.           finally
  308.             free;
  309.           end;
  310.           TempStream.Position:=0;
  311.           TempLines.Clear;
  312.           TempLines.LoadFromStream(TempStream);
  313.           MsgLines.AddStrings(TempLines);
  314.         end;
  315.       end;
  316.     end;
  317.   finally
  318.     TempStream.Free;
  319.     TempLines.Free;
  320.   end;
  321. end;
  322.  
  323. procedure TMsgProcessor.Process;
  324. var
  325.   TempSection : TSection;
  326.   i : Integer;
  327. begin
  328.   FillHeaders;
  329.   if GetHeaderValue(Headers,'Mime-Version')<>'1.0' then
  330.     HandleSingleSection
  331.   else
  332.     HandleMultipleSections;
  333.   ProcessSections;
  334. end;
  335.  
  336. procedure TMsgProcessor.DecodeButtonClick(Sender: TObject);
  337. begin
  338.   AttachmentsDir:=AddBackSlash(AttachmentsDir);
  339.   Memo1.Cursor:=crHourGlass;
  340.   Panel1.Cursor:=crHourGlass;
  341.   Panel1.Enabled:=false;
  342.   try
  343.     Process;
  344.     Memo1.Lines:=MsgLines;
  345.   finally
  346.     Memo1.Cursor:=crDefault;
  347.     Panel1.Cursor:=crDefault;
  348.     Panel1.Enabled:=true;
  349.     DecodeButton.Enabled:=false;
  350.   end;
  351. end;
  352.  
  353. procedure TMsgProcessor.SaveButtonClick(Sender: TObject);
  354. begin
  355.   SaveDialog1.InitialDir:=AttachmentsDir;
  356.   if SaveDialog1.Execute then
  357.   begin
  358.     MsgStream.SaveToFile(SaveDialog1.FileName);
  359.   end;
  360. end;
  361.  
  362. initialization
  363.   AttachmentsDir:='';
  364. end.
  365.  
  366.